home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / graphics / scalemod.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-05-16  |  10.7 KB  |  290 lines
  1. VERSION 2.00
  2. Begin Form frmScaleMode 
  3.    Caption         =   "ScaleMode Display"
  4.    ClientHeight    =   3885
  5.    ClientLeft      =   405
  6.    ClientTop       =   1515
  7.    ClientWidth     =   4905
  8.    Height          =   4290
  9.    Left            =   345
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3885
  13.    ScaleWidth      =   4905
  14.    Top             =   1170
  15.    Width           =   5025
  16.    Begin PictureBox picDraw 
  17.       DragIcon        =   SCALEMOD.FRX:0000
  18.       Height          =   1935
  19.       Left            =   960
  20.       ScaleHeight     =   1905
  21.       ScaleWidth      =   2865
  22.       TabIndex        =   2
  23.       Top             =   720
  24.       Width           =   2895
  25.    End
  26.    Begin PictureBox picXaxis 
  27.       Height          =   255
  28.       Left            =   0
  29.       ScaleHeight     =   225
  30.       ScaleWidth      =   4665
  31.       TabIndex        =   1
  32.       Top             =   3600
  33.       Width           =   4695
  34.    End
  35.    Begin PictureBox picYAxis 
  36.       Height          =   3615
  37.       Left            =   4680
  38.       ScaleHeight     =   3585
  39.       ScaleWidth      =   225
  40.       TabIndex        =   0
  41.       Top             =   0
  42.       Width           =   255
  43.    End
  44. Const DM_COPYPEN = 1
  45. Const DM_NOTXORPEN = 10
  46. Dim oldCursorX As Single
  47. Dim oldCursorY As Single
  48. Dim bTracking As Integer
  49. Dim Anchor(1) As Single
  50. Dim bDrag As Integer
  51. Dim bFirst As Integer
  52. Sub DrawCursorLocation (Source As Control, X As Single, Y As Single, OldRedraw As Integer, NewRedraw As Integer)
  53.     Dim fcolor As Long
  54.     Dim ii As Integer
  55.     Dim sParam As String
  56.     Dim oldDrawMode As Integer
  57.     Dim oldDrawWidth As Integer
  58.     Dim location As Single
  59.     If True Then
  60.         'Redraw the X-Axis Cursor Marker
  61.         oldDrawMode = picXaxis.DrawMode
  62.         oldDrawWidth = picXaxis.DrawWidth
  63.         picXaxis.DrawMode = DM_NOTXORPEN      'Not XOR
  64.         picXaxis.DrawWidth = 2
  65.         'Redraw the old mark
  66.         If OldRedraw = True Then
  67.             location = picXaxis.ScaleWidth * (oldCursorX - Source.ScaleLeft) / Source.ScaleWidth - picXaxis.ScaleLeft
  68.             picXaxis.Line (location, 0)-(location, picXaxis.ScaleHeight)
  69.         End If
  70.         'Draw the new mark
  71.         If NewRedraw = True Then
  72.             location = picXaxis.ScaleWidth * (X - Source.ScaleLeft) / Source.ScaleWidth + picXaxis.ScaleLeft
  73.             picXaxis.Line (location, 0)-(location, picXaxis.ScaleHeight)
  74.         End If
  75.         'Store the old Cursor locations and reset the Draw Properties
  76.         oldCursorX = X
  77.         picXaxis.DrawMode = oldDrawMode
  78.         picXaxis.DrawWidth = oldDrawWidth
  79.         'Redraw the Y-Axis Cursor Marker
  80.         oldDrawMode = picXaxis.DrawMode
  81.         oldDrawWidth = picXaxis.DrawWidth
  82.         'Set DrawMode to NOTXORPEN
  83.         picYaxis.DrawMode = DM_NOTXORPEN      'Not XOR
  84.         picYaxis.DrawWidth = 2
  85.         'Redraw the old mark
  86.         If OldRedraw = True Then
  87.             location = picYaxis.ScaleHeight * (oldCursorY - Source.ScaleTop) / Source.ScaleHeight - picYaxis.ScaleTop
  88.             picYaxis.Line (0, location)-(picYaxis.ScaleWidth, location)
  89.         End If
  90.         If NewRedraw = True Then
  91.             'Draw the new mark
  92.             location = picYaxis.ScaleHeight * (Y - Source.ScaleTop) / Source.ScaleHeight + picYaxis.ScaleTop
  93.             picYaxis.Line (0, location)-(picYaxis.ScaleWidth, location)
  94.         End If
  95.         'Store the old Cursor locations and reset the Draw Properties
  96.         oldCursorY = Y
  97.         picYaxis.DrawMode = oldDrawMode
  98.         picYaxis.DrawWidth = oldDrawWidth
  99.     Else
  100.         ii = SetTextAlign(Source.hDC, TA_BOTTOM)
  101.         fcolor = Source.ForeColor
  102.         Source.ForeColor = Source.BackColor
  103.         Source.CurrentX = oldCursorX
  104.         Source.CurrentY = oldCursorY
  105.         Source.Print Tag
  106.         Source.ForeColor = fcolor
  107.         Source.CurrentX = X
  108.         Source.CurrentY = Y
  109.         oldCursorX = X
  110.         oldCursorY = Y
  111.         sParam = "(" + LTrim$(RTrim$(Str$(Int(X)))) + "," + LTrim$(RTrim$(Str$(Int(Y)))) + ")"
  112.         Source.Print sParam
  113.         Source.Tag = sParam
  114.     End If
  115. End Sub
  116. Sub DrawXRuler (Source As Control, Ruler As Control)
  117.     Const MAJORINC = 10
  118.     Const MINORINC = 4
  119.     Dim ii As Integer
  120.     Dim jj As Integer
  121.     Dim numstr As String
  122.     Dim ScaleInterval As Single
  123.     Dim ScaleValue As Single
  124.     Dim MajorInt As Integer
  125.     Dim MinorInt As Integer
  126.     'Initialize Ruler scale values
  127.     picXaxis.ScaleMode = 0      'User-defined
  128.     picXaxis.ScaleWidth = 1000
  129.     picXaxis.ScaleHeight = 100
  130.     MajorInt = Ruler.ScaleWidth / MAJORINC
  131.     MinorInt = MajorInt / MINORINC
  132.     ScaleValue = Source.ScaleLeft
  133.     ScaleInterval = Source.ScaleWidth / MAJORINC
  134.     Ruler.Cls
  135.     start = Int(Ruler.ScaleLeft)
  136.     finish = Int(Ruler.ScaleLeft + Ruler.ScaleWidth)
  137.     For ii = start To finish Step MajorInt
  138.         numstr = LTrim$(RTrim$(Str$(Int(ScaleValue))))
  139.         Ruler.Line (ii, 0)-(ii, Ruler.ScaleHeight / 6)
  140.         Ruler.CurrentX = ii - Ruler.TextHeight(numstr) / 2
  141.         Ruler.CurrentY = Ruler.ScaleHeight / 6
  142.         Ruler.Print numstr
  143.         For jj = 1 To MINORINC
  144.             Ruler.Line (ii + MinorInt * jj, 0)-(ii + MinorInt * jj, Ruler.ScaleHeight / 8)
  145.         Next jj
  146.         ScaleValue = ScaleValue + ScaleInterval
  147.     Next ii
  148.    If bFirst Then
  149.       oldDrawMode = picXaxis.DrawMode
  150.       oldDrawWidth = picXaxis.DrawWidth
  151.       'Set DrawMode to NOTXORPEN
  152.       picXaxis.DrawMode = DM_NOTXORPEN      'Not XOR
  153.       picXaxis.DrawWidth = 2
  154.       location = picXaxis.ScaleWidth * (oldCursorX - ScaleLeft) / ScaleWidth + picXaxis.ScaleLeft
  155.       picXaxis.Line (location, 0)-(location, picXaxis.ScaleHeight)
  156.       picXaxis.DrawMode = oldDrawMode
  157.       picXaxis.DrawWidth = oldDrawWidth
  158.    End If
  159. End Sub
  160. Sub DrawYRuler (Source As Control, Ruler As Control)
  161.     Const MAJORINC = 10
  162.     Const MINORINC = 4
  163.     Dim ii As Integer
  164.     Dim jj As Integer
  165.     Dim numstr As String
  166.     Dim ScaleInterval As Single
  167.     Dim ScaleValue As Single
  168.     Dim MajorInt As Integer
  169.     Dim MinorInt As Integer
  170.     picYaxis.ScaleMode = 0      'User-defined
  171.     picYaxis.ScaleWidth = 100
  172.     picYaxis.ScaleHeight = 1000
  173.     MajorInt = Ruler.ScaleHeight / MAJORINC
  174.     MinorInt = MajorInt / MINORINC
  175.     ScaleValue = Source.ScaleTop
  176.     ScaleInterval = Source.ScaleHeight / MAJORINC
  177.     Ruler.Cls
  178.     For ii = Int(Ruler.ScaleTop) To Int(Ruler.ScaleTop + Ruler.ScaleHeight) Step MajorInt
  179.         numstr = LTrim$(RTrim$(Str$(Int(ScaleValue))))
  180.         Ruler.Line (0, ii)-(Ruler.ScaleWidth / 6, ii)
  181.         Ruler.CurrentX = Ruler.ScaleWidth / 6
  182.         Ruler.CurrentY = ii - Ruler.TextHeight(numstr) / 2
  183.         Ruler.Print numstr
  184.         For jj = 1 To MINORINC
  185.             Ruler.Line (0, ii + MinorInt * jj)-(Ruler.ScaleWidth / 8, ii + MinorInt * jj)
  186.         Next jj
  187.         ScaleValue = ScaleValue + ScaleInterval
  188.     Next ii
  189.    If bFirst Then
  190.       oldDrawMode = picXaxis.DrawMode
  191.       oldDrawWidth = picXaxis.DrawWidth
  192.       'Set DrawMode to NOTXORPEN
  193.       picYaxis.DrawMode = 10      'Not XOR
  194.       picYaxis.DrawWidth = 2
  195.       location = picYaxis.ScaleHeight * (oldCursorY - ScaleTop) / ScaleHeight + picYaxis.ScaleTop
  196.       picYaxis.Line (0, location)-(picYaxis.ScaleWidth, location)
  197.       picYaxis.DrawMode = oldDrawMode
  198.       picYaxis.DrawWidth = oldDrawWidth
  199.    End If
  200. End Sub
  201. Sub Form_Load ()
  202.     'Initialize Ruler Locations
  203.     picYaxis.Width = 455
  204.     picXaxis.Height = 255
  205.     picDraw.Width = frmScaleMode.Width - picYaxis.Width
  206.     picDraw.Height = frmScaleMode.Height - picXaxis.Height
  207.     'Initialize Ruler scale values
  208.     picXaxis.ScaleMode = 0      'User-defined
  209.     picXaxis.ScaleWidth = 1000
  210.     picXaxis.ScaleHeight = 100
  211.     picYaxis.ScaleMode = 0      'User-defined
  212.     picYaxis.ScaleWidth = 100
  213.     picYaxis.ScaleHeight = 1000
  214.     'Initialize Ruler fonts
  215.     picXaxis.FontName = "Arial"
  216.     picXaxis.FontSize = 6
  217.     picYaxis.FontName = "Arial"
  218.     picYaxis.FontSize = 6
  219.     oldCursorX = 0
  220.     oldCursorY = 0
  221.     bTracking = False
  222.     bFirst = False
  223.     Form2.Show MODELESS
  224. End Sub
  225. Sub Form_Resize ()
  226.     'Resize and rescale drawing control
  227.     picDraw.Move ScaleLeft, ScaleTop, ScaleWidth - picYaxis.Width, ScaleHeight - picXaxis.Height
  228.     If Form2.optScaleMode(0).Value = True Then
  229.         picDraw.Scale (Form2.txtScale(0), Form2.txtScale(1))-(Form2.txtScale(2), Form2.txtScale(3))
  230.     End If
  231.     'Resize rulers
  232.     picXaxis.Move ScaleLeft, ScaleHeight - picXaxis.Height, picDraw.Width, picXaxis.Height
  233.     picYaxis.Move ScaleWidth - picYaxis.Width, ScaleTop, picYaxis.Width, picDraw.Height
  234. End Sub
  235. Sub Form_Unload (Cancel As Integer)
  236.     Unload Form2
  237.     End
  238. End Sub
  239. Sub picDraw_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  240.     bTracking = True
  241.     Anchor(0) = X
  242.     Anchor(1) = Y
  243.     picDraw.DrawMode = 10
  244.     picDraw.Line (Anchor(0), Anchor(1))-(Anchor(0), Anchor(1)), , B
  245. End Sub
  246. Sub picDraw_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  247.     Dim rtn As Integer
  248.      
  249.     'If tracking, erase the old rectangle and draw the new one.
  250.     If bTracking Then
  251.         picDraw.Line (Anchor(0), Anchor(1))-(oldCursorX, oldCursorY), , B
  252.         picDraw.Line (Anchor(0), Anchor(1))-(X, Y), , B
  253.     Else
  254.         'If not tracking, check to see if the mouse has
  255.         'left the picDraw window. If so, erase the cursor
  256.         'location marks on the X and Y axis scales and
  257.         'release capture of the mouse back to the system.
  258.         If X < picDraw.ScaleLeft Or X > picDraw.ScaleLeft + picDraw.ScaleWidth Or Y < picDraw.ScaleTop Or Y > picDraw.ScaleTop + picDraw.ScaleHeight Then
  259.             DrawCursorLocation picDraw, X, Y, True, False
  260.             ReleaseCapture
  261.             bFirst = False
  262.             Exit Sub
  263.         End If
  264.     End If
  265.     'Draw the current cursor location on the X and Y axis.
  266.     DrawCursorLocation picDraw, X, Y, bFirst, True
  267.     'If bFirst is False, it means we are entering the
  268.     'picDraw window. Set capture on the mouse so as to
  269.     'detect when it leaves the window and set bFirst to True.
  270.     If Not bFirst Then
  271.         rtn = SetCapture(picDraw.hWnd)
  272.         bFirst = True
  273.     End If
  274. End Sub
  275. Sub picDraw_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
  276.     'MouseUp automatically releases capture of the mouse.
  277.     'For this reason, we must SetCapture again on the MouseUp event
  278.     'in order to detect when the mouse leaves the picDraw window.
  279.     If bTracking Then
  280.         rtn = SetCapture(picDraw.hWnd)
  281.         bTracking = False
  282.     End If
  283. End Sub
  284. Sub picXaxis_Paint ()
  285.     DrawXRuler picDraw, picXaxis
  286. End Sub
  287. Sub picYAxis_Paint ()
  288.     DrawYRuler picDraw, picYaxis
  289. End Sub
  290.